perm filename ULAP.80[MAC,LSP] blob
sn#251575 filedate 1976-12-02 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00026 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002
C00005 00003
C00008 00004
C00010 00005
C00012 00006
C00015 00007
C00019 00008
C00022 00009
C00024 00010
C00026 00011
C00029 00012
C00031 00013
C00032 00014
C00034 00015
C00037 00016
C00039 00017
C00041 00018
C00046 00019
C00047 00020
C00050 00021
C00052 00022
C00054 00023
C00056 00024
C00058 00025
C00059 00026
C00062 ENDMK
C⊗;
;;; **************************************************************
;;; ***** MACLISP ****** UTAPE, LAP, AND AGGLOMERATED SUBRS ******
;;; **************************************************************
;;; ** (C) COPYRIGHT 1976 MASSACHUSETTS INSTITUTE OF TECHNOLOGY **
;;; ****** THIS IS A READ-ONLY FILE! (ALL WRITES RESERVED) *******
;;; **************************************************************
PGBOT [UIO]
IFN QIO,[
SUBTTL OLD I/O FUNCTIONS IN TERMS OF NEW I/O PRIMITIVES
;;; (DEFUN UREAD FEXPR (FILENAME)
;;; (UCLOSE)
;;; ((LAMBDA (FILE)
;;; (EOFFN UREAD
;;; (FUNCTION
;;; (LAMBDA (EOFFILE EOFVAL)
;;; (UCLOSE)
;;; EOFVAL)))
;;; (INPUSH (SETQ UREAD FILE))
;;; (CAR (DEFAULTF FILE)))
;;; (OPEN (*UGREAT FILENAME) 'IN)))
UREAD: PUSH P,A ;FEXPR
PUSHJ P,UCLOSE
POP P,A
PUSHJ P,UGREAT
PUSH P,[UREAD2]
PUSH P,A
JRST $OPEN
UREAD2: MOVEM A,VUREAD
PUSH P,[UREAD1]
PUSH P,A
PUSH P,[QUREOF]
MOVNI T,2
JRST EOFFN
UREAD1: HRRZ A,VUREAD
PUSHJ P,INPUSH
PUSHJ P,DEFAULTF
JRST $CAR
UREOF: PUSH P,B ;+INTERNAL-UREAD-EOFFN - SUBR 2
PUSHJ P,UCLOSE
JRST POPAJ
;;; (DEFUN UCLOSE FEXPR (X)
;;; (COND (UREAD
;;; ((LAMBDA (OUREAD)
;;; (AND (EQ OUREAD INFILE) (INPUSH -1))
;;; (SETQ UREAD NIL)
;;; (CLOSE OUREAD))
;;; UREAD))
;;; (T NIL)))
UCLOSE: SKIPN A,VUREAD ;FEXPR
POPJ P,
CAMN A,VINFILE
PUSHJ P,INPOP ;SAVES A
SETZM VUREAD
JRST $CLOSE
;;; (DEFUN UWRITE FEXPR (DEVDIR)
;;; (OR DEVDIR (SETQ DEVDIR (CAR (DEFAULTF NIL))))
;;; (*UWRITE (CONS DEVDIR
;;; (COND ((STATUS FEATURE DEC10)
;;; (CONS (STATUS JNAME) '(OUT)))
;;; ((STATUS FEATURE ITS)
;;; '(.LISP. OUTPUT))))
;;; 'OUT
;;; (LIST DEVDIR)))
;;;
;;; (DEFUN UAPPEND FEXPR (FILENAME)
;;; (PROG2 (SETQ FILENAME (*UGREAT FILENAME))
;;; (*UWRITE FILENAME 'APPEND FILENAME)
;;; (RENAME UWRITE
;;; (COND ((STATUS FEATURE DEC10)
;;; (CONS (STATUS JNAME) '(OUT)))
;;; ((STATUS FEATURE ITS)
;;; '(/.LISP/. APPEND))))))
;;;
;;; (DEFUN *UWRITE (NAME MODE NEWDEFAULT) ;INTERNAL ROUTINE
;;; (COND (UWRITE
;;; (SETQ OUTFILES (DELQ UWRITE OUTFILES))
;;; (CLOSE UWRITE)
;;; (SETQ UWRITE NIL)))
;;; ((LAMBDA (FILE)
;;; (SETQ OUTFILES
;;; (CONS (SETQ UWRITE FILE)
;;; OUTFILES))
;;; (CAR (DEFAULTF NEWDEFAULT)))
;;; (OPEN NAME MODE)))
UAPPEND: PUSHJ P,UGREAT ;FEXPR
MOVEI C,(A)
MOVEI B,QAPPEND
PUSHJ P,UWRT1
PUSH P,A
HRRZ A,VUWRITE
MOVEI B,QLSPAPP
PUSHJ P,$RENAME
JRST POPAJ
UWRITE: JUMPN A,UWRT0 ;FEXPR
PUSHJ P,DEFAULTF
HLRZ A,(A)
UWRT0: PUSHJ P,NCONS
MOVEI C,(A)
HLRZ A,(C)
MOVEI B,QLSPOUT
PUSHJ P,CONS
MOVEI B,Q$OUT
UWRT1: PUSH P,C ;*UWRITE BEGINS HERE
PUSH P,[UWRT2]
PUSH P,A
PUSH P,B
SKIPE VUWRITE
PUSHJ P,UFILE5
MOVNI T,2
JRST $OPEN
UWRT2: MOVEM A,VUWRITE
HRRZ B,VOUTFILES
PUSHJ P,CONS
MOVEM A,VOUTFILES
POP P,A
PUSHJ P,DEFAULTF
JRST $CAR
;;; IFN QIO
;;; (DEFUN UFILE FEXPR (SHORTNAME)
;;; (COND ((NULL UWRITE)
;;; (ERROR 'NO/ UWRITE/ FILE
;;; (CONS 'UFILE SHORTNAME)
;;; 'IO-LOSSAGE))
;;; (T (PROG2 NIL
;;; (CAR (DEFAULTF (RENAME UWRITE
;;; (*UGREAT SHORTNAME))))
;;; (SETQ OUTFILES (DELQ UWRITE OUTFILES))
;;; (CLOSE UWRITE)
;;; (SETQ UWRITE NIL)
;;; (OR OUTFILES (SETQ ↑R NIL))))))
UFILE0: MOVEI B,QUFILE
PUSHJ P,XCONS
IOL [NO UWRITE FILE!]
UFILE: SKIPN VUWRITE ;FEXPR
JRST UFILE0
PUSHJ P,UGREAT
MOVEI B,(A)
HRRZ A,VUWRITE
PUSHJ P,$RENAME
PUSHJ P,DEFAULTF
PUSH P,A
PUSHJ P,UFILE5
POP P,A
JRST $CAR
UFILE5: HRRZ A,VUWRITE
HRRZ B,VOUTFILES
PUSHJ P,.DELQ
MOVEM A,VOUTFILES
HRRZ A,VUWRITE
PUSHJ P,$CLOSE
SETZM VUWRITE
SKIPN VOUTFILES
SETZM TAPWRT
POPJ P,
;;; (DEFUN CRUNIT FEXPR (DEVDIR)
;;; (CAR (DEFAULTF (AND DEVDIR (LIST DEVDIR)))))
SCRUNIT: SETZ A,
CRUNIT: SKIPE A ;FEXPR
PUSHJ P,NCONS
PUSHJ P,DEFAULTF
JRST $CAR
;;; IFN QIO
;;; (DEFUN *UGREAT (NAME) ;INTERNAL ROUTINE
;;; (MERGEF (MERGEF NAME
;;; (COND ((STATUS DEC10)
;;; '(* . LSP))
;;; (T '(* . >))))
;;; NIL))
UGREAT: PUSH P,[6BTNML]
UGRT1: PUSHJ P,FIL6BT
REPEAT 3, PUSH FXP,[SIXBIT \*\]
10% PUSH FXP,[SIXBIT \>\]
10$ PUSH FXP,[SIXBIT \LSP\]
PUSHJ P,IMRGF
JRST DMRGF
;;; (DEFUN UPROBE FEXPR (FILENAME)
;;; (SETQ FILENAME (MERGEF (*UGREAT FILENAME) NIL))
;;; (PROBEF FILENAME))
UPROBE: PUSHJ P,UGRT1 ;FEXPR
JRST PROBF0
;;; (DEFUN UKILL FEXPR (FILENAME)
;;; (DEFAULTF (DELETEF FILENAME))))
UKILL: PUSHJ P,$DELETEF
JRST DEFAULTF
] ;END OF IFN QIO
IFE QIO,[
SUBTTL OLD I/O FUNCTIONS IN TERMS OF OLD I/O PRIMITIVES
CRUNIT: JUMPN A,UINIT0 ;GET (MAYBE AFTER SETTING) CRUNIT
SCRUNIT: MOVE A,IUNIT ;GET CRUNIT
JRST UINIT1
UINIT0: HLRZ C,(A) ;CAR IS DEVICE
HRRZ A,(A) ;CADR IS DIRECTORY
SKIPN A
HRRZ A,@IUNIT ;IF NOT GIVEN, USE PRESENT ONE
HLRZ A,(A)
PUSHJ P,NCONS ;MAKE UP NEW CRUNIT
MOVE B,C
PUSHJ P,XCONS
UINIT1: MOVEM A,IUNIT ;SAVE NEW CRUNIT
HLRZ A,@IUNIT
PUSHJ P,SIXMAK ;GET SIXBIT FOR DEVICE
10% HLRM TT,UTIN
10$ MOVEM TT,UTIN
HRRZ A,@IUNIT
HLRZ A,(A)
IFN ITS,[
PUSHJ P,SIXMAK ;GET SIXBIT FOR DIRECTORY
CAME TT,USN
.SUSET [.SSNAM,,TT]
] ;END OF IFN ITS
IFN D10,[
IFE SAIL,[
JSP T,SPATOM
JRST .+3
PUSHJ P,SIXMAK ;SIXBIT PPN
JRST UINIT2
HLRZ B,(A)
JSP T,FXNV2 ;PROJ # IN D
HRRZ A,(A)
HLRZ A,(A)
JSP T,FXNV1 ;PROG # IN TT
HRLI TT,(D)
UINIT2:
] ;END OF IFE SAIL
IFN SAIL,[
HLRZ B,(A) ;PROJ# IN B
HRRZ A,(A)
HLRZ A,(A) ;PROG# IN A
PUSH P,B ;LH PART ON PDL
PUSHJ P,SIXMAK ;GET SIXBIT FOR RH PART
PUSHJ P,SARGT ;RIGHT JUSTIFY BOX
PUSH FXP,TT ;ON ANOTHER STACK
POP P,A ;LH IN A
PUSHJ P,SIXMAK ;GET SIXBIT FOR LH
PUSHJ P,SARGT ;R.J.
POP FXP,D
HLR TT,D ;INSTALL RH PART
] ;END OF IFN SAIL
] ;END OF IFN D10
MOVEM TT,USN
MOVE A,IUNIT
POPJ P,
IFN SAIL,[
SARGT: TLNE TT,77 ;IS RIGHTMOST CHAR ZERO?
POPJ P, ;WIN
LSH TT,-6 ;SLYDE RIGHT
JRST SARGT ;ONE MORE TIME, NOW.
] ;END OF IFN SAIL
IFE D10,[
UGREAT: AOJN T,CPOPJ ;HACK FOR UREAD AND UFILE
HLRZ A,(A) ; TO DEFAULT SECOND FILE NAME TO >
MOVEI B,QGRTL
JRST CONS
] ;END OF IFE D10
;;; IFE QIO
SUBTTL OLD I/O UFILE
UFILE: JSP TT,FWNACK
10% FA01234,,QUFILE
10$ FA0234,,QUFILE
SKIPN UTOOPD
JRST UFILE0
10% PUSHJ P,UGREAT
PUSHJ P,UFNAME
UFILE1: LOCKI
SETZM TAPWRT
IFN ITS,[
MOVEM T,UTIN+3
MOVEM TT,UTIN+4
MOVE T,UWRT
MOVEM T,UTIN
SETZM UTIN+1
MOVEI T,UTOC
MOVEM T,UTIN+2
MOVEI A,↑C
PUSHJ P,UTTYO
.FDELE UTIN
UFRL: LERR [SIXBITCH \FILE RENAME LOST!\]
MOVE T,UTOBP
CAMN T,UTOIBP
JRST UFRL1
SKIPA TT,[↑C] ;PAD OUT WITH CONTROL-C'S
IDPB TT,T
TLNE T,740000
JRST .-2
HRLZS T
MOVSI TT,UTOB-1
SUB TT,T
HRRI TT,UTOB
.IOT UTOC,TT
UFRL1: .CLOSE UTOC,
] ;END OF IFN ITS
IFN D10,[
MOVEM T,D10REN ;MOVE FILENAME TO RENAME BLOCK
MOVEM T+1,D10REN+1
SETZB T,T+2
MOVE T+1,UWRT
OPEN DELC,T
JRST NODEV
MOVE T,D10REN
MOVE T+1,D10REN+1
SETZ T+2,
MOVE T+3,UWUSN
LOOKUP DELC,T ;FIND OLD FILE IF ANY
JRST D10NDL
SETZ T,
RENAME DELC,T ;DELETE ...
JRST D10DL1 ;ARG!
RELEASE DELC,
D10NDL: MOVE T,D10REN ;GET OLD NAME AGAIN
SETZ T+2,
MOVE T+3,UWUSN
TRZ T+1,-1
SA$ CLOSE UTOC, ;LOSING SAIL WON'T FORCE OUTPUT WITHOUT THIS
RENAME UTOC,T
LERR [SIXBIT \FILE RENAME LOST!\]
RELEASE UTOC,
] ;END OF IFN D10
MOVE A,UWUNIT
MOVEM A,IUNIT
SETZM UTOOPD
UNLKPOPJ
UFILE0: MOVEI A,QUFILE
PUSHJ P,NCONS
%FAC [SIXBIT \NO UWRITE FILE OPEN - UFILE!\]
IFN D10,[
D10DL1: MOVEI B,QUFILE
JRST UFLER
] ;END OF IFN D10
UKILL: JSP TT,FWNACK
FA0234,,QUKILL
MOVEI T,0
PUSH P,IUNIT
PUSHJ P,UINITA ;DOES A LOCKI
IFE D10,[
SETZM UTIN+3
.FDELE UTIN
JRST UKLER
] ;END OF IFE D10
IFN D10,[
MOVE T+1,UTIN ;PICK UP DEVICE NAME
SETZB T,T+2
OPEN DELC,T ;GET THE DEVICE
JRST UKLER
HLLZ T+1,UFN2 ;GET EXTENSION
MOVE T,UFN1
SETZ T+2,
MOVE T+3,USN
LOOKUP DELC,T
JRST UKLER
SETZB T,T+1 ;ZAP THE FILE NAME
RENAME DELC,T ;BYE
JRST UKLER
RELEASE DELC,
] ;END OF IFN D10
SUB P,R70+1
UNLKPOPJ
;;; IFE QIO
SUBTTL OLD I/O UWRITE
UWRITE: JSP TT,FWNACK
FA012,,QUWRITE
10% SKIPE UTOOPD
10% PUSHJ P,UWRT2
PUSHJ P,CRUNIT
LOCKI
SETOM UAPOS
IFE D10,[
MOVE T,[SIXBIT \.LISP.\]
MOVE TT,[SIXBIT \OUTPUT\]
MOVEM T,UTIN+1
MOVEM TT,UTIN+2
PUSHJ P,UTOINT
MOVEI T,3
UWRT0: HRLM T,UTIN ;UAPPEND JOINS IN HERE
MOVEM A,UWUNIT
TSOPEN UTOC,UTIN
MOVE T,UTIN
MOVEM T,UWRT
SKIPGE UAPOS
JRST UWRT3
.ACCESS UTOC,UAPOS
SETZM UTIN+1
MOVEI T,UTOC
MOVEM T,UTIN+2
MOVE T,[SIXBIT \.LISP.\]
MOVE TT,[SIXBIT \APPEND\]
MOVEM T,UTIN+3
MOVEM TT,UTIN+4
.FDELE UTIN
JRST UFRL
UWRT3:
] ;END OF IFE D10
IFN D10,[
MOVEM A,UWUNIT
SETZ T,
MOVE T+1,UTIN ;GET DEVICE
MOVEM T+1,UWRT
MOVSI T+2,UTOHED
OPEN UTOC,T
NODEV: LERR [SIXBIT \DEVICE NOT AVAILABLE!\]
UWRT0: MOVEI T,UTOB-3
EXCH T,.JBFF"
OUTBUF UTOC,1
EXCH T,.JBFF"
MOVE T,D10NAM
MOVSI T+1,(SIXBIT \OUT\)
SKIPL UAPOS
MOVSI T+1,(SIXBIT \APP\)
SETZ T+2,
MOVE T+3,USN
MOVEM T+3,UWUSN
ENTER UTOC,T ;MAKE THE FILE
NOENT: LERR [SIXBIT \CANNOT ENTER FILE!\]
SKIPL UAPOS
SA% USETI UTOC,-1 ;SAIL MOVE ACCESS POINTER TO END OF FILE
SA$ UGETF UTOC,SAILF2 ;SAIL MOVE ACCESS POINTER TO END OF FILE
] ;END OF IFN D10
AOS UTOOPD
JRST UEXIT
IFE D10,[
UWRT2: PUSH P,A
JSP T,SPECBIND
TAPWRT
MOVE T,[SIXBIT \.LISP.\]
MOVE TT,[SIXBIT \OUTPUT\]
PUSHJ P,UFILE1
PUSHJ P,UNBIND
JRST POPAJ
] ;END OF IFE D10
;;; IFE QIO
SUBTTL OLD I/O UAPPEND
UAPPEND: JSP TT,FWNACK
10% FA01234,,QUAPPEND
10$ FA0234,,QUAPPEND
10% PUSHJ P,UGREAT
10% SKIPE UTOOPD
10% PUSHJ P,UWRT2
PUSH P,IUNIT
10% MOVEI T,2
PUSHJ P,UINITA
IFE D10,[
.OPEN UTOC,UTIN
JRST UAPPER
.CALL UAFLEN
.VALUE
UAPP1: SUBI TT,1
.ACCESS UTOC,TT
MOVE T,[-1,,UTOB]
.IOT UTOC,T
MOVSI T,-5
MOVE D,UTOB
LSH D,-1
UAPP2: LSHC D,-7
LSH R,-35
JUMPE R,UAPP3
CAIE R,↑L
CAIN R,↑C
JRST UAPP3
PUSHJ P,UTOINT
HLRE D,T
ADDM D,UTOBYT
IMULI T,7
ADDI T,1
DPB T,[360600,,UTOBP]
MOVEM TT,UAPOS
MOVE A,IUNIT
SUB P,R70+1
MOVEI T,100003
JRST UWRT0
UAPP3: AOBJN T,UAPP2
JRST UAPP1
UAFLEN: SETZ
SIXBIT \FILLEN\
1000,,UTOC
402000,,TT
] ;END OF IFE D10
;;; IFE QIO
IFN D10,[ ;DROPS IN
SETZ D,
MOVE D+1,UTIN
MOVEM D+1,UWRT
MOVSI D+2,UTOHED
OPEN UTOC,D
JRST NODEV
TRZ T+1,-1
SETZ T+2,
MOVE T+3,USN
LOOKUP UTOC,T
JRST UAPPER
SETZB T,T+2
MOVE T+1,UWRT
OPEN DELC,T
JRST NODEV
MOVE T,D10NAM
MOVSI T+1,(SIXBIT \APP\)
SETZ T+2,
MOVE T+3,USN
LOOKUP DELC,T
JRST D10UAN
SETZ T,
RENAME DELC,T
JRST D10UAN
RELEASE DELC,
D10UAN: MOVE T,D10NAM
MOVSI T+1,(SIXBIT \APP\)
SETZ T+2,
MOVE T+3,USN
RENAME UTOC,T
JRST UAPPER
TRZ T+1,-1
SETZ T+2,
MOVE T+3,USN
LOOKUP UTOC,T
JRST UAPPER
MOVE A,IUNIT
SUB P,R70+1
MOVEM A,UWUNIT
SETZM UAPOS
JRST UWRT0
] ;END OF IFN D10
;;; IFE QIO
SUBTTL OLD I/O UREAD
UREAD: JSP TT,FWNACK
10% FA01234,,QUREAD
10$ FA0234,,QUREAD
10% PUSHJ P,UGREAT
PUSH P,IUNIT
IFE D10,[
MOVEI T,2 ;ORDINARY READ USES BLOCK ASCII INPUT
PUSHJ P,UINITA ;LOCKI DONE BY UINITA
.OPEN UTIC,UTIN
JRST UROER
] ;END OF IFE D10
IFN D10,[
PUSHJ P,UINITA
SETZ D,
MOVE D+1,UTIN ;GET DEVICE
MOVEI D+2,UTIHED
OPEN UTIC,D
JRST UROER
TRZ T+1,-1 ;FLUSH JUNK
SETZ T+2,
MOVE T+3,USN
LOOKUP UTIC,T ;IS THE FILE THERE?
JRST UROER
TRZ T+1,-1 ;FLUSH LOOKUP JUNK
MOVEM T,URFN1
MOVEM TT,URFN2
MOVE T,IUNIT
MOVEM T,URUNIT
MOVEI T,UTIB-3
EXCH T,.JBFF"
INBUF UTIC,1
EXCH T,.JBFF"
] ;END OF IFN D10
SUB P,R70+1
UREAD2:
10% MOVE T,[440700,,UTIB+UTBSIZ]
10% MOVEM T,UTIBP
MOVEI T,<↑C>←13
HRLZM T,UTIB+UTBSIZ
AOS UTIOPD
SKIPE ALGCF ;MUST AVOID CONSING WHILE IN ALLOC
JRST UEXIT
IFE D10,[
MOVE T,[UTIC,,URCHST] ;GET STATUS OF UREAD CHANNEL
.RCHST T,
MOVSI T,(SIXBIT \@\) ;IF DIDN'T GET FILE NAMES BACK,
SKIPN TT,URCHST+2 ; WANT TO USE @'S
SKIPA TT,T
MOVE T,URCHST+1
MOVEM T,URFN1 ;SAVE AS FILE NAMES FOR
MOVEM TT,URFN2 ; (STATUS UREAD)
HRRZ A,IUNIT
MOVE TT,URCHST+3 ;COMPARE DEV AND SNAME TO IUNIT
CAME TT,USN
JRST UREAD4
LDB T,[140600,,URCHST]
CAIE T,(SIXBIT \ UT\)
SKIPA T,URCHST
HRRZ T,URCHST
TLNE T,-1
HLRZS T
SUB T,UTIN
TRNN T,-1
JRST UREAD6
UREAD4: HRRZ A,(A) ;IF THEY DIFFER, MUST CONS UP URUNIT
JUMPE TT,UREAD5 ;IF NO SNAME, MUST BE FUNNY DEV - USE IUNIT'S SNAME
MOVE A,[440600,,URCHST+3] ;CONS UP SNAME
SETZM URCHST+4
PUSHJ P,READ6C
PUSHJ P,NCONS
UREAD5: PUSH P,A
MOVE A,[220600,,URCHST] ;CONS UP DEVICE NAME
SETZM URCHST+1
PUSHJ P,READ6C
POP P,B
PUSHJ P,CONS
UREAD6: MOVEM A,URUNIT ;SAVE UREAD UNIT
] ;END OF IFE D10
UEXIT: MOVE A,IUNIT
UNLKPOPJ
;;; IFE QIO
SUBTTL OLD I/O UCLOSE AND UPROBE
UCLOSE: SETZ T,
MOVEI D,QUCLOSE
JUMPN A,WNAFOSE
SKIPN A,UTIOPD
POPJ P,
JSP A,.UEOF
JRST TRUE
UPROBE: JSP TT,FWNACK
10% FA01234,,QUPROBE
10$ FA0234,,QUPROBE
10% PUSHJ P,UGREAT
HRRZ B,IUNIT
JSP T,SPECBIND
0 B,IUNIT
SAVEFX UFN1 UFN2
10% MOVEI T,2
PUSHJ P,UINITA
10% .OPEN ERRC,UTIN
IFN D10,[
SETZB D,D+2
MOVE D+1,UTIN
OPEN DELC,D
JRST UPROB3
TRZ T+1,-1
SETZ T+2,
MOVE T+3,USN
LOOKUP DELC,T
UPROB3:
] ;END OF IFN D10
TDZA A,A
MOVEI A,TRUTH
10% .CLOSE ERRC,
10$ RELEASE DELC,
JUMPE A,UPROB7
PUSH P,[440600,,UFN1]
MOVE A,[440600,,UFN2]
PUSHJ P,READ6C
HRRZ B,IUNIT
PUSHJ P,CONS
EXCH A,(P)
PUSHJ P,READ6C
POP P,B
PUSHJ P,CONS
UPROB7: UNLOCKI
RSTRFX UFN2 UFN1
JRST UNBIND
;;; IFE QIO
UINITA: PUSH P,A
10% HRLM T,(P)
UNTA1: MOVEI T,.
JUMPE A,UNTA2
HRRZ A,(A)
JUMPE A,UNTAER
HRRZ A,(A)
UNTA2: PUSHJ P,CRUNIT
LOCKI
MOVE A,(P)
10% HLLM A,UTIN
HRRZS A,(P)
PUSHJ P,UFNAME
10% MOVEM T,UTIN+1
10% MOVEM TT,UTIN+2
JRST POPAJ
UFNAME: JUMPE A,UFNM
PUSH P,A
MOVEI B,IN0+10.
JSP T,SPECBIND
0 B,VBASE
0 B,V.NOPOINT
UFNA1: HLRZ A,(A)
PUSHJ P,SIXMAK
HRRZ A,@(P)
MOVEI T,UFNA1
JUMPE A,UNTAER
MOVEM TT,UFN1
HLRZ A,(A)
SUB P,R70+1
PUSHJ P,SIXMAK
MOVEM TT,UFN2
PUSHJ P,UNBIND
UFNM: MOVE T,UFN1
MOVE TT,UFN2
POPJ P,
] ;END OF IFE QIO
SUBTTL SYMBOL MANIPULATION AND SQUOZE FUNCTIONS
GETDDTSYM:
10% JSP T,SIDDTP ;LOSE IF NO DDT FROM WHICH TO GET SYMBOL
10$ SKIPN .JBSYM" ;LOSE IF NO JOB SYMBOL TABLE
JRST FALSE
PUSHJ P,RSQUEEZE
$GETDDTSYM: ;SQUOZE IN TT - USED BY NON-DEC-10 FASLAP
10% .BREAK 12,[4,,TT]
10% JUMPE TT,FALSE
10% MOVE TT,TT+1
10$ PUSHJ P,GETDD0
10$ JRST FALSE
JRST FIX1
TTSR: PUSH P,CFIX1 ;SUBR 1 - NCALLABLE (TTSR|)
MOVEI C,(A) ;SAVES AR1,R,F - SEE FASLOAD
PUSHJ P,ARGET
JUMPN A,TTSR1
JSP T,SACONS
MOVEI T,ADEAD
MOVEM T,ASAR(A)
MOVE T,[TTDEAD]
MOVEM T,TTSAR(A)
MOVEI B,(A)
MOVEI A,(C)
MOVEI C,QARRAY
PUSHJ P,PUTPROP
TTSR1: MOVSI T,TTS<CN>
IORM T,TTSAR(A)
MOVEI TT,1(A)
POPJ P,
RSQUEEZE: ;CANONICAL SQUOZE CONVERSION
10$ HRROS (P) ;FOR DEC-10, GIVES DEC-10 SQUOZE
SQUEEZE: ;THIS ALWAYS GIVES LEFT-JUSTIFIED SQUOZE
MOVEI AR1,6 ;CONVERT PNAME-ATOM TO SQUOZE AND SIXBIT
MOVE AR2A,[440600,,SQ6BIT] ;RETURNS SQUOZE IN TT, SIXBIT IN SQ6BIT
SETZM SQ6BIT ;CLEAR LOCS USED TO ACCUMULATE
SETZM SQSQOZ ; SIXBIT AND SQUOZE
HRROI R,SQZCHR
PUSHJ P,PRINTA ;"PRINT" OUT CHARS OR PNAME
IFN D10,[
MOVE TT,SQSQOZ
POP P,F
TLNE F,1
JRST (F)
SOJL AR1,(F)
IMULI TT,50
JRST .-2
] ;END OF IFN D10
IFE D10,[
SKIPA TT,SQSQOZ
IMULI TT,50 ;IF FEWER THAN 6 CHARS, MUST
SOJGE AR1,.-1 ; MULTIPLY ITS SQUOZE UP TO SIZE
POPJ P,
] ;END OF IFE D10
SQZCHR: TLNN AR2A,770000 ;IGNORE MORE THAN 6 CHARS
POPJ P,
SUBI A,40 ;CONVERT TO SIXBIT
CAIL A,1 ;LOSSAGE IF NOT SIXBIT CHAR
CAILE A,77 ; - ALSO, SPACE IS A LOSS
MOVEI A,'. ;LOSING NON-SQUOZE CHAR
IDPB A,AR2A ;DEPOSIT SIXBIT CHAR
CAIL A,'A ;CHECK FOR LETTER
CAILE A,'Z
JRST SQNOTL
SUBI A,'A-13 ;CONVERT TO SQUOZE VALUE
SQOK: EXCH T,SQSQOZ
IMULI T,50
ADDI T,(A)
EXCH T,SQSQOZ
SOJA AR1,CPOPJ ;DECR COUNT AND RETURN TO PRINTA
SQNOTL: CAIL A,'0 ;CHECK FOR DIGIT
CAILE A,'9
JRST SQNOTD
SUBI A,'0-1 ;CONVERT TO SQUOZE VALUE
JRST SQOK
SQNOTD: CAIE A,'$ ;CHECK FOR $ OR %
CAIN A,'%
JRST SQ%$
MOVEI A,'. ;ANY CHAR OTHER THAN A-Z, 0-9, $, OR %
DPB A,AR2A ; DEFAULTS TO . (E.G. *FOOBAR -> .FOOBA)
MOVEI A,45-42
SQ%$: ADDI A,42 ;SQUOZE VALUE FOR $,%,.
JRST SQOK
5BTWD: PUSH P,CFIX1
$5BTWD: PUSH FXP,R70
5BTWD0: MOVEI C,(A)
HRRZ B,(A)
JUMPE B,5BTWD1
HLRZ A,(A)
JSP T,FXNV1
LSH TT,-2
MOVEM TT,(FXP)
MOVEI A,(B)
5BTWD1: HLRZ A,(A)
JSP T,SPATOM
JRST 5BTWD9
PUSHJ P,SQUEEZE
MOVE R,SQ6BIT
POP FXP,D
DPB D,[400400,,TT]
POPJ P,
5BTWD9: SETZM (FXP)
MOVEI A,(C)
WTA [BAD ARG - SQUOZE!]
JRST 5BTWD0
UNSQOZ: LDB T,[004000,,D] ;HAIRY MESS TO CONVERT
SETZM LD6BIT ; SQUOZE TO SIXBIT
UNSQZ1: IDIVI T,50 ;(THIS IS SEPARATE ROUTINE SO
JUMPE TT,UNSQZ2 ; LAP LOSERS CAN USE IT)
CAIL TT,45 ;<1SQUOZE .>
JRST UNSQZ3
CAIL TT,13 ;<1SQUOZ A> IS 13
ADDI TT,'A-13 ;CONVERT RANGE A - Z ,
CAIGE TT,13 ;<1SQUOZ 1> IS 1
ADDI TT,'0-1 ;CONVERT RANGE 0 - 9
UNSQZ2: IOR TT,LD6BIT
ROT TT,-6
MOVEM TT,LD6BIT
JUMPN T,UNSQZ1
MOVE A,[440600,,LD6BIT] ;MAKE SIXBIT INTO AN ATOM
JRST READ6C
UNSQZ3: SUBI TT,46-'$ ;[1SQUOZ $] IS 46, [1SQOZ .] IS 45
CAIN TT,45-<46-'$> ;CONVERT RANGE $ - %
MOVEI TT,'* ;BUT . IS EXCEPTIONAL
JRST UNSQZ2
IFN D10,[
GETDD0: SKIPA D,.JBSYM" ;FIND SYMBOL IN JOB SYMBOL TABLE
GETDD1: ADD D,R70+2
JUMPGE D,CPOPJ
MOVE T,(D)
TLZ T,540000
TLZN T,200000 ;SYMBOL MUSTN'T BE KILLED
CAME T,TT ;MUST BE THE ONE WE WANT
JRST GETDD1
MOVE TT,1(D)
AOJA D,POPJ1
] ;END OF IFN D10
PUTDDTSYM:
MOVEI R,0 ;PUTDDTSYM| IS FOR LAP - OFFSETS VALUE BY LOAD OFFSET
PUTDD0:
10% JSP T,SIDDTP ;LOSE IF NO DDT TO GIVE SYMBOL TO
10$ SKIPN .JBSYM"
JRST FALSE
PUSH FXP,R
PUSH P,B
10$ SKIPL R ;SEE LDPUT1
PUSHJ P,RSQUEEZE ;SQUEEZE ATOM'S PNAME DOWN TO SQOUZE CODE
POP P,B
10% .BREAK 12,[3,,D]
POP FXP,R
10% JUMPE D,FALSE
IFE ITS,[
PUSHJ P,GETDD0
JRST PUTDD4
MOVEI F,(D)
] ;END OF IFE ITS
PUTDD2: JSP T,FXNV2 ;GET VALUE OF SECOND ARG
ADDI D,(R) ;ADD IN OFFSET
10% .BREAK 12,[400004,,TT]
10$ MOVEM D,(F)
JRST TRUE
IFN D10,[
PUTDD4: SOSGE SYMLO
JRST FALSE
MOVE F,R70+2
SUBB F,.JBSYM"
TLO TT,100000 ;LOCAL SYMBOL
MOVEM TT,(F)
AOJA F,PUTDD2
] ;END OF IFN D10
SUBTTL LAPSETUP AND FASLAPSETUP
LAPSETUP: JUMPN A,LAPSMH ;ARG = NIL => SETUP SOME SYM PROPERTIES
MOVEI T,LAPST2
LAP5HAK: PUSH P,T ;APPLIES THE ROUTINE FOUND IN T TO ALL THE GLOBALSYMS
PUSH P,[441100,,LAP5P] ;ATOMIC SYMBOL PLACED IN A, GLOBALSYM INDEX IN TT
MOVSI F,-LLSYMS
L5H1: ILDB TT,(P) ;HAFTA GET THE GLOBALSYM INDEX FROM PERMUTATION TABLE
CAIL TT,LGSYMS ;IF THIS IS NOT A GLOBALSYM [BUT AN XTRASYM], SKIP IT
JRST L5XIT
CAIN TT,3 ;SO NEVER, BUT NEVER CHANGE THE GLOBALSYM INDICES FOR
JRST L5SPBND ; SPECBIND 3
CAIN TT,25 ; ERSETUP 25
JRST L5ERSTP ; MAKUNBOUND 34
CAIN TT,34 ; INHIBIT 47
JRST L5MKUNBD ; 0*0PUSH 53
CAIN TT,47 ; NILPROPS 54
JRST L5INHIBI ;THOSE GUYS HAVE MORE THAN 6 CHARS IN THEIR PNAME
CAIN TT,53 ;AND CANT BE RECONSTRUCTED BY UNSQOZ'ING FROM
JRST L50.0P ;FROM THE LAPFIV TABLE
CAIN TT,54
JRST L5NILP
MOVE D,LAPFIV(F)
PUSHJ P,UNSQOZ
L5H2: LDB TT,(P)
PUSHJ P,@-1(P)
L5XIT: AOBJN F,L5H1
JRST POP2J
L5ERSTP: MOVEI A,[SIXBIT \ERSETUP \]
JRST L5H3
L5SPBND: MOVEI A,[SIXBIT \SPECBIND \]
L5H3: HRLI A,440600
PUSHJ P,READ6C
JRST L5H2
L5MKUNBD: MOVEI A,[SIXBIT \MAKUNBOUND \]
JRST L5H3
L5INHIBIT: MOVEI A,[SIXBIT \INHIBIT \]
JRST L5H3
L50.0P: MOVEI A,[SIXBIT \0*0PUSH \]
JRST L5H3
L5NILP: MOVEI A,[SIXBIT \NILPROPS\]
JRST L5H3
LAPSMH: CAIE A,TRUTH ;(LAPSETUP| T 2) MEANS
JRST LAPSM1 ; SET UP THE XCT HACK AREAS
JSP T,FXNV2 ; WITH 2 XCT PAGES
MOVE TT,D
JRST LDXHAK
LAPSM1: MOVEI T,(B) ;OTHERWISE, FIRST ARG IS ADDRESS
MOVEI R,(A) ; TO HACK, SECOND NON-NIL =>
MOVE TT,(R) ; TRY THE XCT-PAGE HAK
PUSHJ P,PRCHAK ;TRY TO SMASH (SKIP ON FAILURE)
JRST TRUE
MOVEI A,(AR2A)
MOVE B,VPURCLOBRL
PUSHJ P,CONS
MOVEM A,VPURCLOBRL
JRST TRUE
IFE QIO,[
FSLSTP:
JUMPE A,FSLST1 ;ARG = NIL => INITIALIZING FASLAP
MOVE F,[-LFLSYMS,,FLSYMS] ;ARG=T => LOADING IN A FASLAP
SKIPA A,[440600,,FLAPSIX]
LSUP3A: MOVE A,CORBP ;CLOBBER IN SOME SYM PUTPROPS
LSUP3: PUSHJ P,READ6C
HRRZ TT,(F)
PUSHJ P,LSYMPUT
AOBJN F,LSUP3A
JRST TRUE
] ;END OF IFE QIO
LAPST2: MOVE TT,LSYMS(TT) ;GET ACTUAL VALUE FROM GLOBALSYM INDEX
LSYMPUT: MOVEI B,(A) ;EXPECTS SYMBOL IN A, VALUE IN TT
JSP T,FXCONS
LSMPT1: EXCH A,B
MOVEI C,QSYM
JRST PUTPROP
Q% FSLST1:
Q$ FSLSTP:
MOVEI T,FSLST2
PUSHJ P,LAP5HAK
MOVE TT,LDFNM2
JRST FIX1
FSLST2: MOVEI C,(A) ;MAKE UP ATOMIC SYMBOLS AND GIVE THEM SYM PROPERTIES
JSP T,FXCONS ; OF THE FORM (0 (NIL <N>))
PUSHJ P,NCONS ; WHERE <N> IS THE INDEX OF THE SYMBOL
SETZ B, ; (THESE ARE THE "GLOBALSYMS")
PUSHJ P,XCONS
PUSHJ P,NCONS
MOVE B,CIN0
PUSHJ P,XCONS
MOVEI B,(C)
JRST LSMPT1
IFE QIO,[
DEFINE FLSYM B
IRP A,,[DSIC]
B
TERMIN
IFN D10,[
IRP A,,[IOO,D10NAM,UFN1,UFN2,USN]
B
TERMIN
] ;END OF IFN D10
TERMIN
FLSYMS: FLSYM A
LFLSYMS==.-FLSYMS
FLAPSIX: .BYTE 6
FLSYM [IRPC Q,,[A]
'Q
TERMIN
0 ]
.BYTE
] ;END OF IFE QIO
R70 ;GLOBALSYM NUMBER -1
LSYMS: GLBSYM A
LGSYMS==.-LSYMS ;END OF GLOBALSYMS HACKED BY FASLAP
XTRSYM A
LLSYMS==.-LSYMS ;END OF ALL GLOBAL SYMBOLS
;;; SIXBIT FOR LAP SYMBOL NAMES; MUST MATCH IRP LIST OF GLBSYM
ZZ==0
LAPSIX: .BYTE 6
SIXSYM [
IRPC Q,,[A]
'Q
TERMIN
0
ZZ==ZZ+1
] ;END OF SIXSYM ARGUMENT
.BYTE
IFN ZZ-LGSYMS, WARN [LAPSIX OUT OF PHASE]
EXPUNGE ZZ
LAPFIV:
GLBSYM [SQUOZE 0,A]
XTRSYM [SQUOZE 0,A]
HAOLNG LOG2LL5,<LLSYMS-1> ;CROCK FOR BINARY SEARCH
REPEAT <1←LOG2LL5>-LLSYMS, 377777,,777777
LAP5P: BLOCK <LLSYMS+3>/4 ;PERMUTATION, STORED 4/WD, TO GET GLOBALSYMINDEX FROM LAPFIV INDEX
LGTSPC: MOVEM TT,GAMNT
ADD TT,@VBPORG ;INSURE THAT BPEND-BPORG > (TT)
SUB TT,@VBPEND
JUMPGE TT,GTSPC1 ;MUST RELOCATE, OR GET MORE CORE.
MOVE A,VBPEND ;ALREADY OK
MOVE TT,(A)
POPJ P,
PAGEBPORG: MOVE A,VBPORG ;MAKE SURE BPORG IS ON PAGE BOUNDRY
MOVE TT,(A) ;NUMERIC VALUE OF BPORG
TRNN TT,PAGKSM
POPJ P,
ADDI TT,PAGSIZ-1
ANDCMI TT,PAGKSM
CAMGE TT,@VBPEND
JRST PGBP4
PUSH FXP,TT ;NEW VALUE FOR BPORG
JSP T,SPECBIND
0 VNORET
AOS VNORET
PUSH P,CUNBIND
SUB TT,(A)
PUSHJ P,LGTSPC
JUMPE TT,[LERR [SIXBIT \NO CORE - PAGEBPORG!\]]
POP FXP,TT
PGBP4: JSP T,FIX1A
MOVEM A,VBPORG ;GIVE BPORG NEW PAGIFIED VALUE
POPJ P,
SUBTTL MAKUNBOUND
MAKUBE: %WTA [SIXBIT \UNCHANGEABLE VALUE - MAKUNBOUND!\]
MAKUNBOUND: ;SUBR 1 - FLUSH VALUE OF ATOMIC SYMBOL
BAKPRO
JSP D,SETCK ;MAKE SURE IT'S A SYMBOL
JUMPE A,MAKUBE
CAIN A,TRUTH
JRST MAKUBE
HLRZ T,(A)
MOVE B,(T)
TLNE B,300 ;CAN'T RECLAIM VALUE CELL IF PURE
JRST MAKUN1 ; OR IF COMPILED CODE NEEDS IT
TLZ B,-1
CAIN B,SUNBOUND ;CAN'T RECLAIM SUNBOUND!!!
POPJ P,
CAIL B,BXVCSG+NXVCSG*SEGSIZ
JRST MAKUN1 ;CAN'T RECLAIM CELL NOT IN VALUE CELL AREA
EXCH B,FFVC ;SO RECLAIM THE VALUE CELL ALREADY
XCTPRO
MOVEM B,@FFVC
MOVEI B,SUNBOUND ;USE SUNBOUND FOR A VALUE CELL
HRRM B,(T)
NOPRO
POPJ P, ;THAT'S ALL
MAKUN1: PUSH P,A ;MAKE SURE WE RETURN THE ARGUMENT
PUSH P,CPOPAJ
MOVEI B,QUNBOUND ;FALL INTO SET WITH "UNBOUND" VALUE
JRST SET+1
SUBTTL MULTIPLEXOR I/O FUNCTIONS
IFN MOBIOF,[
MPX: JUMPE A,MPX1 ;FIRST ARG FOR IMXC
SOJE A,CIMX ;SECOND FOR OMXC
SOSE A ; NIL - DO NOTHING
MOVSI A,4 ; 0 - CLOSE CHANNEL
HRRI A,(SIXBIT \IMX\) ; 1 - OPEN IN NORMAL MODE
TSOPEN IMXC,A ; 2 - OPEN IN FAST MODE (ASCII)
AOS IMXOPD
MPX1: JUMPE B,TRUE
SOJE B,COMX
SOSE B
MOVEI B,4
HRLZI B,1(B)
HRRI B,(SIXBIT \OMX\)
TSOPEN OMXC,B
AOS OMXOPD
JRST TRUE
CIMX: .CLOSE IMXC,
SETZM IMXOPD
JRST MPX1
COMX: .CLOSE OMXC,
SETZM OMXOPD
JRST TRUE
OMPX: SKIPN OMXOPD
LERR [SIXBIT \OMX NOT OPENED!\]
JSP T,FXNV1
DPB TT,[360600,,R]
JSP T,FXNV2
DPB D,[221400,,R]
.IOT OMXC,R
POPJ P,
IMPX: SKIPN IMXOPD
LERR [SIXBIT \IMX NOT OPENED!\]
JSP T,FXNV1
.IOT IMXC,TT
JRST FIX1
OPNGEN IMX,0
OPNGEN OMX,1
] ;END OF IFN MOBIOF
IFN USELESS,[
SUBTTL PURIFICATION RITES
$PURIFY:
IFN D10, POPJ P,
IFE D10,[
SETZ AR1,
JSP T,FXNV1 ;GET TWO MACHINE NUMBERS
JSP T,FXNV2
ANDCMI TT,1777 ;PAGIFY FIRST DOWNWARD
IORI D,1777 ;PAGIFY SECOND UPWARD
CAMLE TT,D
LERR [SIXBIT \ARG 2 < ARG 1 - PURIFY!\]
JUMPE C,FPURF3 ;NULL THIRD ARG MEANS DEPURE
HLRZ T,LDXBLT ;CHECK TO SEE IF PURIFYING XCT CALL PAGES
JUMPE T,FPURF0
CAML T,TT
CAMLE T,D
JRST FPURF0
MOVSI T,400000
IORM T,LDXSIZ ;IF SO, SET FLAG - CAN'T ADD NEW CALLS TO THOSE PAGES
FPURF0: CAIE C,QBPORG
JRST FPURF3
FPURF7: MOVSI F,2000 ;THIS BIT CONVERTS CALL TO CALLF, JCALL TO JCALLF
MOVEI T,VPURCL
PUSH P,T
FPURF1: HRRZ T,(T) ;CDR DOWN THE PURLIST
FPUR1Q: JUMPE T,FPURF2
FPUR1A: HLRZ AR2A,(T)
PUSHJ P,LDSMSH ;TRY TO SMASH
JRST FPURF4 ;WIN
IORM F,(AR2A) ;LOSE - MAKE IT A CALLF/JCALLF
FPURF4: HRRZ T,@(P) ;WIN, SO CUT IT OUT OF PURCLOBRL
HRRZ T,(T)
HRRM T,@(P)
JRST FPUR1Q
FPURF3: JSP R,IP0
POPJ P,
] ;END OF IFE D10
IP0: ;PURIFY/DEPURIFY SOME PAGES
IFN D10, JRST (R)
IFE D10,[
LSH D,-PAGLOG ;CALLED BY JSP R,IP0
LSH TT,-PAGLOG ;USES B,C,T,TT,D,F
CAIGE TT,1
LERR [SIXBIT \1ST PAGE NOT PURE!\]
MOVEI B,(TT) ;FOR BIBOP, FIGURE OUT BYTE
ROT B,-4 ; POINTER FOR UPDATING PURTBL
ADDI B,(B)
ROT B,-1
TLC B,770000
ADD B,[450200,,PURTBL]
SUBI D,-1(TT) ;CALCULATE NUMBER OF PAGES
IMULI TT,1001
TRO TT,400000 ;SET UP ARG FOR .CBLK
SKIPN C
TLOA TT,400
SKIPA C,R70+2 ;FOR BIBOP, 1=IMPURE, 2=PURE
MOVEI C,1 ; IN PURTBL ENTRY
IP7: .CBLK TT, ;HACK PAGE
JSP F,IP1 ;IP1 HANDLES LOSSES
ADDI TT,1001
TLNN B,730000 ;FOR BIBOP, DEPOSIT BYTE IN PURTBL
TLZ B,770000
IDPB C,B
SOJN D,IP7
JRST (R)
IP1: MOVE T,[4400,,776000] ;ASSUME FAILURE WAS DUE TO SHARING
.CBLK T, ;USES ONLY T,TT
.LOSE 1000+%ENACR ;NO CORE AVAILABLE
LDB T,[111000,,TT]
LSH T,PAGLOG+22
HRRI T,376*PAGSIZ ;SO COPY PAGE INTO SOME FAKE PAGE
BLT T,376*PAGSIZ+1777 ;LIKE PAGE NUMBER 376
MOVE T,TT
ANDCMI T,377
IORI T,376
.CBLK T, ;MOVE PAGE MAP FOR 376 INTO LOSING PAGE POSITION
.VALUE
MOVEI T,376000
.CBLK T, ;FLUSH ENTRY FOR PAGE 376
.VALUE
JRST (F)
;;; IFN USELESS
;;; IFE D10
IPUR9: SETZ
SIXBIT \CORTYP\
1000,,400(R)
402000,,T
UNPURIFY: ;UNPURIFY ALL PAGES (MOSTLY FOR JPG)
MOVNI R,NPAGS ;DO *NOT* MUNG PURTBL!!!
MOVE TT,[0400,,400000]
UNPUR1: .CALL IPUR9
.VALUE
JUMPLE T,UNPUR2
.CBLK TT,
JSP F,IP1
UNPUR2: ADDI TT,1001
AOJL R,UNPUR1
.VALUE [ASCIZ \:≠UNPURIFIED≠
\]
] ;END OF IFE D10
] ;END OF IFN USELESS
SUBTTL 100$G RESETS THE WORLD!
GOINIT:
10% .SUSET [.S40ADDR,,[TWENTY,,FORTY]] ;SET .40ADDR
MOVEI A,READTABLE
MOVEM A,VREADTABLE
IFN USELESS,[
MOVE A,[RCT0,,RCT]
BLT A,RCT+LRCT-1 ;RESTORE READ CHARACTER SYNTAX TABLE
] ;END OF IFN USELESS
IFE QIO,[
IFN D10,[
PUSHJ P,SIXJBN
MOVE TT,D10NAM
MOVEM TT,UFN1
MOVSI TT,(SIXBIT \TMP\)
MOVEM TT,UFN2
] ;END OF IFN D10
IFE D10,[
MOVSI TT,(SIXBIT \@\)
MOVEM TT,UFN1
MOVEM TT,UFN2
MOVE TT,[GOINI9,,STTYS1]
BLT TT,STTYS2
] ;END OF IFE D10
] ;END OF IFE QIO
IFN EDFLAG,[
SETZM VDLDLDL
SETZM EDUPLST
SETZM EDSRCH
] ;END OF IFN EDFLAG
IFN QIO,[
MOVEI A,TTYIFA
MOVEM A,V%TYI
MOVEI A,TTYOFA
MOVEM A,V%TYO
MOVEI A,TRUTH
MOVEM A,VINFILE
SETZM VINSTACK
SETZM VOUTFILES
SETZM VECHOFILES
MOVEI A,QTLIST
MOVEM A,VMSGFILES
IFN USELESS,[
MOVEI T,IB<MAR> ;RESET THE MAR BREAK FEATURE
ANDCAM T,INTMSK
.SUSET [.SAMASK,,T]
.SUSET [.SMARA,,R70]
] ;END OF IFN USELESS
] ;END OF IFN QIO
MOVEI A,OBARRAY
MOVEM A,VOBARRAY ;GET BACK TOPLEVEL OBARRAY
Q% SETZM VPRIN1
Q$ SETZM V%PR1
SETZM VOREAD
SETZM TLF
SETZM BLF ;??
SETZM UNRC.G ;CLEAR STACKED NOINTERRUPT STUFF
SETZM UNRRUN
SETZM UNRTIM
SETZM UNREAR
SETZM TTYOFF
JSP A,ERINIT
GOINI7: SETZB A,VERRLI ;NULLIFY ERRLIST
PUSHJ P,INTERN
JUMPE A,LISPGO
PUSHJ P,REMOB2 ;GET STANDARD COPY OF NIL ON OBLIST
JRST GOINI7
IFE QIO+D10,[
GOINI9: STTYW1 ;INITIAL TTY STATUS WORDS
STTYW2
] ;END OF IFE QIO
;;; UTAPESTUFF, LAPSTUFF, AND SYSP, MPX, COPYSYMBOL, PURIFY, GOINIT
PGTOP UIO,[UTAPE, LAP, AND AGGLOMERATED SUBRS]